00100		TITLE LOOP	;	SUBROUTINE LOOP(I,J,L,M,N)
00200		ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX,JUGGLE,XNOTE,BAUTO
00300		ENTRY	SORT2,UPDATE,NEWR,MSSLUP,LUP2,HOMER,FSCAN,NALF,BOX
00400		EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL,SCM
00500		EXTERNAL SC,SCX,RRJJ,STF,ALF,POSI,RMOD,RINP,SIZ
00600		EXTERNAL RHORZ,SETCUR,DPYSET,DPYBRT,SETPOG,ALINE
00700		DEFINE FIXX(N)
00800	<	KIFIX N,N  ↔ >	; NEW KL10 FIX
01400				;	DIMENSION N(1)
01500	MM←1 ↔ NN←2 ↔ JK←3 ↔JT←4 ↔IEND←5 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13   
01600	RC←14 ↔ NX←15	;**** AC'S 0,1,2,3,5  ARE USED IN 'PLACE' & 'FINDIT'!!
01700	LOOP:	0		;	DO 1 NN=I+L,J+L,K
01800		MOVE	1,@4(16)
01900		SUB 	1,@3(16) 	; MM IS IN 1
02000		MOVE	2,@(16)
02100		ADD	2,@3(16)	;I+L  -- NN, 1ST TIME
02200		MOVE	3,@1(16)
02300		ADD	3,@3(16)	;J+L
02400		MOVE	4,@2(16)	;K
02500		HRRZI	5,@5(16)		; ADR. OF N
02600		ADDI	2,-1(5)		; N(NN)
02700		ADDI	3,-1(5)
02800		JUMPL	4,LP3		; JUMP IF NEG. INCR.
02900		HRRM	1,.+1		; ADD IN MM 
03000	LP1:	MOVE	6,(2)
03100		MOVEM	6,(2)		;N(NN)=N(NN+MM)
03200		CAIGE	2,(3)
03300		AOJA	2,LP1
03400		JRA	16,6(16)
03500	LP3:	HRRM	1,.+1
03600	LP2:	MOVE	6,(2)		;NEG. INCR.
03700		MOVEM	6,(2)
03800		CAILE	2,(3)
03900		SOJA	2,LP2
04000		JRA 	16,6(16)	;	END
04100	
04200	PLACE:	0	;	FUNCTION PLACE(X)
04300	;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
04400	;	EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
04500		MOVN	2,@(16) ;	PLACE=R11-ABS(RD-X)
04600		FADR	2,RMOD+=9 	;END
04700		MOVMS	2
04800		MOVE 	0,.COMM.+=12	;R11
04900		FSBR	0,2
05000		JRA	16,1(16)
05100	
05200	FINDIT:	0    ;	FUNCTION FINDIT(N)
05300		SETZ   ;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
05400		HRRZ	1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
05500	;;	HRRZI	2,PTR  ;	FINDIT=0
05600	;;	ADDI	1,(2)  ;	L=PWDS(N)
05700	;;	MOVE	2,-1(1) ;	IF(RN(L+1).NE.1)GO TO 377
05800	;;	FIXX(2)         ;	IF(RN(L+2).EQ.R2)RETURN
05900	;;	HRRZI	3,XRN     ;377	FINDIT=-1
06000	;;	ADDI	3,(2)   ;	END
06100	;;	MOVE 5,(3)   ; RN(L+1)
06200		MOVE 2,PTR-1(1)		;THESE 3 REPLACE ABOVE
06300	;X	FIXX(2)
06400		MOVE 5,XRN(2)
06500		CAME	5,[1.0]
06600		JRST	FNEG
06700		MOVEM	2,PTR+=251   ; SENDS BACK A NUM IN L
06800	;;	MOVE	5,1(3)  ;RN(L+2)
06900		MOVE 5,XRN+1(2)
07000		CAME	5,.COMM.
07100	FNEG:	SETO
07200		JRA	16,1(16)
07300	
07400	DPYNEW:	0    ;	SUBROUTINE DPYNEW
07500		JSA	16,ACCPOG    ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
07600		JUMP	[1]    ;	CALL ACCPOG(1)
07700		MOVE	2,DPY+=4251    ;	IF(IGO.GT.0)RETURN
07800		JUMPG	2,DB    ;	CALL DPYOUT(1)
07900		JSA	16,DPYOUT    ;	END
08000		JUMP	[1]
08100	DB:	JRA	16,(16)
08200	
08300	MVBEAM:	0  ;C  THESE MOVE ENDS OF PARTIAL INNER BEAMS.
08400		HRRZ	2,(16) ;	SUBROUTINE MVBEAM(R,I,JY,L,W)
08500		MOVE	5,@1(16)  ; I
08600		ADD	2,5  ;C  L AND JY ARE FOR MOVES TO DIFF. STAFF.
08700		ADD	2,@2(16)  ;	DIMENSION R(1)
08800		MOVE	3,-1(2)  ;	Y=R(JY+I)
08900		MOVM	4,3   ;	Z=ABS(Y)
09000		CAMGE	4,[=100.0]  ;	IF(Z.LT.100.)GO TO 1
09100		JRST	MV1
09200		CAML	5,[6]
09300		JRST	MV1	;  IF(I.GT.5)GO TO 1
09400	;C  NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
09500		JSA	16,AMOD  ;	Y=AMOD(Y,100.)
09600		JUMP	3  
09700		JUMP	[=100.0]  ; 0 HAS Y
09800		MOVE	5,@4(16)  ;	X=Y+W
09900		FADR	5,0
10000		MOVM	6,5  ;	Z=Z-ABS(Y)+ABS(X)
10100		MOVMS	0     ;C  PUTS ALL INTO POSITIVE
10200		FSBR	4,0
10300		FADR	4,6
10400		SKIPGE 	5  ;	IF(X)Z=-Z
10500		MOVNS	4    ; Z
10600		JRST 	MV2 ;	GO TO 2
10700	MV1:	FADR	3,@4(16)  ;1	Z=Y+W
10800		MOVE	4,3   ; Z NOW IN 4
10900	MV2:	HRRZI	3,@(16) ;2	R(L+I)=Z
11000		ADD	3,@3(16)
11100		ADD	3,@1(16)
11200		MOVEM	4,-1(3)  ; PUT IT IN R(L+I)
11300		JRA	16,5(16)	; END
11400	
11500	MVBX:	0   ;	SUBROUTINE MVBX(I)
11600	;     COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
11700		MOVE	2,@(16)  ;	EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
11800		ADD	2,KJY+1 ;	R(L+I)=R8+(R(JY+I)-R4)*RDIS
11900	;;	HRRZI	4,XRN
12000	;;	ADDI	2,(4)
12100	;;	MOVE	3,-1(2)  ; R(JY+I)
12200		MOVE 3,XRN-1(2)
12300		FSBR	3,.COMM.+5
12400		FMPR	3,.COMM.+=25  ; *RDIS
12500		FADR	3,.COMM.+=9   ; +R8
12600		MOVE	2,@(16)
12700		ADD	2,.COMM.+=24   ; + L
12800	;;	ADDI	2,(4)
12900	;;	MOVEM	3,-1(2)    ;R(L+I)
13000		MOVEM 3,XRN-1(2)
13100		JRA	16,1(16)
13200	
13300	JUGGLE:	0    ;	SUBROUTINE JUGGLE
13400	;	IMPLICIT INTEGER(A-Z)
13500	;	REAL PWDS,RN
13600	;	COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
13700	;     COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
13800		SOS	PTR+=250	;ITEM=ITEM-1
13900		HRRZI	15,XRN	;	JX=RN(MEDIT)+3   WD CNT OF OLD ITEM
14000	;C  I-IX IS WD CNT OF NEW ITEM
14100		ADD	15,DPY+=4250
14200		MOVE	14,-1(15)
14300		FIXX(14)
14400		ADDI	14,3  		; JX
14500		MOVE	13,PTR+=253	;JY=IX
14600		MOVE	11,PTR+=252	; I
14700		SUB	11,13
14800		SUB	11,14		;Z=I-IX-JX    SPACE CHANGE
14900		JUMPL	11,J2751   	;IF(Z)2751,172,751
15000		JUMPE	11,J172
15100		MOVE	5,PTR+=252 ;751   CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
15200		SUBI	5,1
15300		MOVE	10,DPY+=4250
15400		ADD	10,14
15500		JSA	16,LOOP
15600		JUMP	5
15700		JUMP	10
15800		JUMP	[-1]
15900		JUMP	11
16000		JUMP	[0]
16100		JUMP	XRN
16200		ADD	13,11		;JY=IX+Z
16300		JRST	J172		;GO TO 172
16400	J2751:	ADD	14,DPY+=4250 ;2751  CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
16500		ADD	14,11
16600		MOVE	5,11
16700		ADD	5,PTR+=253
16800		SOJ	5,
16900		MOVN	10,11
17000		JSA	16,LOOP
17100		JUMP	14
17200		JUMP	5
17300		JUMP	[1]
17400		JUMP	[0]
17500		JUMP	10
17600		JUMP	XRN
17700	;;J172:	HRRZI	12,XRN 		;  172	J=RN(JY)+2
17800	;;	ADDI	12,(13) 		; JY
17900	J172:	MOVE 12,XRN-1(13)
18000	;;	MOVE	12,-1(12) 	;RN(JY)
18100		FIXX(12)
18200		ADDI	12,2		; J IS IN 12
18300		JSA	16,LOOP		;CALL LOOP(0,J,1,MEDIT,JY,RN)
18400		JUMP	[0]
18500		JUMP	12
18600		JUMP	[1]
18700		JUMP	DPY+=4250	; MEDIT
18800		JUMP 	13		; JY
18900		JUMP	XRN
19000		MOVE	12,PTR+=253	; I=IX+Z
19100		ADD	12,11		; Z IS IN 11
19200		MOVEM	12,PTR+=252
19300		MOVE	12,PTR+=250  	; 1751	X=ITEM+1
19400		AOJ	12,	    	; X IS IN 12
19500		HRRZI	13,DPY+=4000   	; JX=WDS(X22+1)-WDS(X22)
19600		ADD	13,DL	
19700		MOVE	14,(13)   	; WDS(X22+1) IN 14  ADR. WDS(X22) IN 13
19800		SUB  	14,-1(13)	;JX IN 14
19900		HRRZI	10,DPY+=4000     	;  J=WDS(X+1)-WDS(X)
20000		ADDI	10,(12)
20100		MOVE	7,(10)		;WDS(X+1)
20200		SUB	7,-1(10)		;J IN 7
20300		MOVEM	7,MVBX		; STORE J
20400		SUB	7,14    	; Y=J-JX
20500		MOVE	14,-1(10)  	;  JX=WDS(X)+Y+1
20600		ADD	14,7
20700		AOJ	14,		; JX IN 14
20800		JUMPL	7,J2851   	;  IF(Y)2851,182,282
20900		JUMPE	7,J182
21000		MOVE	15,(10) ;282  CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
21100		ADDI	15,2	  	; ARG 1
21200		MOVE	6,-1(13) 	;  ARG 2
21300		JSA	16,LOOP
21400		JUMP	15
21500		JUMP	6 
21600		JUMP	[-1]
21700		JUMP	7	  	; Y
21800		JUMP	[0]
21900		JUMP	DPY
22000		JRST	J182   		;  GO TO 182
22100	J2851:	MOVE	14,(13) ;2851  CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
22200		ADD	14,7		;+Y
22300		ADDI	14,1		; ARG 1
22400		MOVE	5,-1(10) 	;WDS(X)
22500		ADD	5,7
22600		ADDI	5,1		; ARG 2
22700		MOVNM	7,MVBEAM	; -Y IS STORED
22800		JSA	16,LOOP
22900		JUMP	14
23000		JUMP	5
23100		JUMP	[1]
23200		JUMP	[0]
23300		JUMP	MVBEAM
23400		JUMP	DPY
23500		MOVE	14,-1(10)  	; WDS(X)   JX=WDS(X)+1
23600		ADDI	14,1		; JX IN 14
23700	J182:	MOVE	5,-1(13)  ;182	CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
23800		ADDI	5,1   	;WDS(X22)+1
23900		JSA	16,LOOP
24000		JUMP	[1]
24100		JUMP	MVBX
24200		JUMP	[1]
24300		JUMP	5  
24400		JUMP	14 
24500		JUMP	DPY
24600		MOVE	2,DL    	; DO 183 K=X22+1,X
24700	;;	HRRZI	5,DPY+=4000  	; 183	WDS(K)=WDS(K)+Y
24800	;;	ADD	5,2
24900		HRRZI	3,PTR
25000		ADDI	3,(2)
25100	;;	TLC	11,232000	; FLOAT Z
25200	;;	FADR	11,11
25300	J183:	JUMPE	11,J184		;IF(Z.EQ.0)GO TO 184
25400		ADDM 11,(3)		; PWDS(K)=PWDS(K)+Z
25500		AOJ	3,	;UPDATE PWDS AND WDS
25600	J184:	JUMPE	7,J185
25700		ADDM 7,(13)
25800		AOJ 13,
25900	J185:	CAIGE	2,(12)
26000		AOJA	2,J183
26100	;;	HRRZI	2,DPY+=4000	;ST(2)=WDS(X)
26200	;;	ADDI	2,(12)		;WDS(X+1) ADR.
26300	;;	MOVE	2,-1(2)
26400		MOVE 2,DPY+=3999(12)
26500	;;	HRRZI	3,DPY
26600	;;	MOVEM	2,1(3)
26700		MOVEM 2,DPY+1
26800		SETZM	DL		;X22=0
26900		JRA	16,(16)
27000	
27100	SORT2:	0		;SUBROUTINE SORT2(RPOS,M)
27200		MOVEI	2,2	;DIMENSION RPOS(2,200)
27300	S3:	MOVE	6,2	;(K=L HERE)
27400		SETO	11,	;L=2
27500		HRRZI	3,@(16)	;3	J=-1
27600		MOVE	4,2	;RX=RPOS(1,L-1)
27700		SUBI	4,1	;L-1
27800		IMULI	4,2
27900		ADDI	4,(3)
28000		MOVE	5,-2(4)	;RX
28100	S2:	MOVE 	7,6	;	DO 2 K=L,M
28200	;;	LSH	7,1	;IF(RPOS(1,K).GE.RX)GO TO 2
28300		IMULI	7,2	;IF(RPOS(1,K).GE.RX)GO TO 2
28400		ADDI	7,(3)
28500		CAMG	5,-2(7)
28600		JRST	S1	; CONTINUE
28700		MOVE	5,-2(7)	;  RX=RPOS(1,K)
28800	;;C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
28900		MOVE 	11,6	;J=K
29000	S1:	CAMGE	6,@1(16)	;2	CONTINUE
29100		AOJA	6,S2
29200		JUMPL	11,S4	;IF(J)GO TO 4
29300		MOVE	12,2	;K=L-1
29400		SOS	12
29500		IMULI	12,2	;(K*2)
29600		ADD	12,3	;CALL EXCH(RPOS(1,K),RPOS(1,J))
29700		MOVE	10,-2(12)
29800	;;	LSH	11,1		;MULTS BY 2 (LEFT SHIFT)
29900		IMULI	11,2
30000		ADD	11,3
30100		EXCH	10,-2(11)
30200		MOVEM	10,-2(12)
30300		MOVE	10,-1(12)	;CALL EXCH(RPOS(2,K),RPOS(2,J))
30400		EXCH	10,-1(11)
30500		MOVEM	10,-1(12)
30600	S4:	CAMGE	2,@1(16)	;4	L=L+1
30700		AOJA	2,S3		;IF(L.LE.M)GO TO 3
30800		JRA	16,2(16)	;END
30900	
31000	XNOTE:	0		;FUNCTION XNOTE(J)
31100		MOVE 	3,@(16)		;COMMON/XRN/RN(4000)
31200		IMULI	3,12		;DIMENSION R(10,80)
31300	;;	ADDI	3,XRN+=2993	;EQUIVALENCE (R,RN(3001))
31400	;;	MOVE	2,(3)		;XNOTE=AMOD(R(4,J),100.)
31500		MOVE 2,RINP-7(3)
31600		JSA	16,AMOD
31700		JUMP	2
31800		JUMP	[=100.0]
31900		JRA	16,1(16)	;END
32000	
32100	BAUTO:	0		;	SUBROUTINE BAUTO(J,L,K,N)
32200				;C  FOR AUTOMATIC BEAMS.
32300		MOVEI 2,2 	;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
32400		ADDB 2,@(16)		;J=J+2
32500	;;	MOVE	3,@3(16)
32600		MOVE	4,@1(16)
32700		SUB	4,@3(16)	;L-N
32800		MOVE	5,@2(16)
32900		SUB	5,@3(16)	;K-N
33000	;;	HRRZI	6,SCM
33100	;;	ADDI	6,(2)
33200		TLC	4,232000
33300		FADR	4,4		;FLOATS IT
33400		MOVEM	4,SC+16(2)		;VX(J-1)=L-N
33500	;;	MOVEM 4,SCM-2(2) ****** WAS V(J-1)
33600	;**** A LIMIT OF 25 BEAMS PER LINE.
33700		TLC	5,232000
33800		FADR	5,5		;FLOATS IT
33900		MOVEM	5,SC+17(2)		;VX(J)=K-N
34000	;;	MOVEM 5,SCM-1(2)
34100		JRA	16,4(16)
34200	
34300	UPDATE:	0	;	SUBROUTINE UPDATE(I)
34400	;;	HRRZI	3,XRN  ;COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
34500	;;	ADD	3,PTR+=252	;RN(IS)=I
34600		MOVE 3,PTR+=252
34700		MOVE	2,@(16)
34800		TLC	2,232000	;FLOAT I
34900		FADR	2,2
35000	;;	MOVEM	2,-1(3)
35100		MOVEM 2,XRN-1(3)
35200	;;	MOVE	2,PTR+=252
35300	;;	ADD	2,@(16)
35400	;;	ADDI	2,3
35500	;;	MOVEM	2,PTR+=252	;IS=IS+I+3
35600		MOVE 2,@(16)
35700		ADDI 2,3
35800		ADDM 2,PTR+=252
35900		JRA	16,1(16)
36000	
36100	IK:	0	;***** DON'T USE THESE ELSEWHERE, THEY STORE NUMBS.!!
36200	JIT:	0  ; THESE ARE TO STORE PNTRS IN LOOP
36300	NEWR:	0	;	SUBROUTINE NEWR
36400		MOVE	A,SC+=70	;COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
36500		CAIE	A,1		;COMMON/XRN/RN(4000)
36600		JRST	N1	;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
36700		MOVE JK,PTR+=252;COMMON/SCX/RHY(4),JALPHA(30),JX,U,JZ,IRHY,J4,KA,KB,IZ
36800		MOVEM JK,IK  ;1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
36900		MOVE JT,PTR+=250  ;1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
37000	 	MOVEM	JT,JIT  	;DIMENSION R(10,80)	
37100	N1:	MOVE	IS,IK		;EQUIVALENCE (R,RN(3001))
37200		MOVEM	IS,PTR+=252
37300		MOVE 14,[9999.0]
37400		MOVE 	JT,JIT		;IF(MODE.NE.1)GO TO 1
37500		ADDI	JT,1		;IK=IS
37600		MOVEM	JT,PTR+=250	;HOMER=ITEM
37700		MOVEI	K,=10		;1	IS=IK
37800		MOVE	IZ,SCX+=41	;ITEM=HOMER+1 ******************** WAS +=33
37900		IMULI	IZ,=10 ;MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
38000	;;N2:	HRRZI	R,XRN+=2997	;DO 2 K=1,IZ
38100	;;;;N2:	MOVE	R,XRN+=2997(K)	;DO 2 K=1,IZ
38200	;;	ADD	R,K		;IF(R(8,K).EQ.9999.)GO TO 2
38300	;;	MOVE	R,(R)
38400	;;;;	CAMN	R,[=9999.0]
38500	N2:	CAMN 14,RINP-3(K)
38600		JRST	NN2  ;SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
38700		SETO	IEND,		;C  JUMP FOR BEAM CONT.
38800	;;	HRRZI	L,XRN		;IEND=-1
38900	;;	ADD	L,PTR+=252	;RN(IS+3)=0
39000	;;	SETZM	2(L)
39100	;;	SETZM	1(L)		;RN(IS+2)=0
39200		MOVE L,PTR+=252
39300		SETZM XRN+2(L)
39400		SETZM XRN+1(L)
39500		MOVEI	L,=9 ;C  ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
39600	;;N3:	HRRZI	R,XRN+=3000	;DO 3 L=9,1,-1
39700	N3:	HRRZI	R,RINP(K)   	;DO 3 L=9,1,-1
39800	;;	ADDI	R,(K)		;A=R(L,K)
39900		ADDI	R,(L)
40000		MOVE	A,-13(R)	;(OCTAL)=-11
40100		JUMPGE	IEND,NX4	;IF(A.NE.0)GO TO 77
40200		JUMPN	A,NX3		;IF(IEND)GO TO 3
40300		JRST	NN3
40400	NX3:	MOVE	IEND,L		;77	IF(IEND)IEND=L
40500	;;NX4:	HRRZI	R,XRN
40600	;;	ADD	R,PTR+=252	;RN(IS+L)=A
40700	;;	ADDI	R,(L)
40800	;;	MOVEM	A,-1(R)
40900	NX4:	MOVE R,PTR+=252
41000		ADDI R,(L)
41100		MOVEM A,XRN-1(R)
41200	NN3:	CAILE	L,1		;3	CONTINUE
41300		SOJA	L,N3
41400		CAIGE	IEND,3
41500		MOVEI	IEND,3
41600		MOVE	15,IEND		;IF(IEND.LT.3)IEND=3
41700		SUBI	15,2
41800		JSA 	16,UPDATE	;CALL UPDATE(IEND-2)
41900		JUMP	15
42000	NN2:	CAML	K,IZ		;2	CONTINUE
42100		JRA	16,(16)		;END
42200		ADDI	K,=10
42300		JRST	N2
42400	
42500	CNT:	0
42600	MSSLUP:	0
42700		SETZ	1,		;161	CNT=1
42800		SETZ	2,
42900	L5543:	MOVE	3,.COMM.+4(2)	;DO 5543 K=1,9
43000	;;	ADDI	3,(2)
43100	;;	MOVE	3,(3)		;RA=RJQ(K)
43200		SKIPE	3		;IF(RA.NE.0)CNT=K
43300		MOVE	1,2
43400	;;	MOVEI	4,RRJJ+1	;5543	RJJ(K)=RA
43500	;;	ADDI	4,(2)
43600	;;	MOVEM	3,(4)
43700		MOVEM 3,RRJJ+1(2)
43800		CAIG	2,7		; LOOP BACK?
43900		AOJA	2,L5543
44000		AOJ	1,
44100		MOVEM	1,CNT		;REMEMBERS CNT
44200		JRA	16,(16)
44300	
44400	LUP2:	0
44500	;;	MOVEI	1,XRN		;261	RN(I)=CNT
44600	;;	ADD	1,PTR+=252
44700		MOVE	2,CNT
44800		TLC	2,232000
44900		FADR	2,2		;FLOATS IT
45000	;;	MOVEM	2,-1(1)
45100		MOVE 1,PTR+=252
45200		MOVEM 2,XRN-1(1)
45300		MOVE	2,.COMM.+1	;RN(I+1)=JA
45400		TLC	2,232000
45500		FADR	2,2
45600	;;	MOVEM	2,(1)
45700	;;	MOVE	2,PTR+=252	;I=I+2
45800	;;	ADDI	2,2
45900	;;	MOVEM	2,PTR+=252
46000		MOVEM 2,XRN(1)
46100		ADDI 1,2
46200		MOVEM 1,PTR+=252
46300		MOVE	3,.COMM.	;RN(I)=R2
46400	;;	MOVEM	3,1(1)
46500		MOVEM 3,XRN-1(1)
46600	;; NOT USED NOW!	IF(RD.NE.0)RN(I)=RD
46700	;;C TO SAVE NOTE NUMBS IN P2.
46800		SETZ	5,		;DO 4554 K=1,CNT
46900	L4554:	MOVE 2,.COMM.+4(5)
47000	;;L4554:	MOVEI	2,.COMM.+4	;(RJQ)
47100	;;	ADDI	2,(5)
47200	;;	MOVE	2,(2)
47300	;;	MOVEI	3,XRN(5)
47400	;;	ADDI	3,(5)
47500	;;	ADD	3,PTR+=252
47600	;;	MOVEM	2,(3)		;4554	RN(I+K)=RJQ(K)
47700		MOVE 3,1
47800		ADDI 3,(5)
47900		MOVEM 2,XRN(3)
48000		AOJ	5,
48100		CAME	5,CNT
48200		JRST	L4554
48300		AOJ	5,
48400	;;	ADD	5,PTR+=252
48500		ADDM 5,PTR+=252
48600	;;	MOVEM	5,PTR+=252	;3554	I=CNT+1+I
48700		JRA	16,(16)
48800	
48900	;;C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
49000	;;	SUBROUTINE HOMER
49100	;;	IMPLICIT INTEGER(A-Q,S-Z)
49200	;;	REAL PWDS,DISX,A,B,PLACE,STFF
49300	;;	COMMON /STF/RSTFAC(-3/4),RSTJ2
49400	;;    COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
49500	;;	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
49600	;;	COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
49700	;;	EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(4000))
49800	;;	1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
49900	;;	1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
50000	HOMER:	0		; IF(JA.EQ.6)GO TO 9
50100		MOVE	MM,.COMM.+1
50200		CAIN	MM,6
50300		JRST	H9
50400		SKIPE	.COMM.+=14	;IF(R13.NE.0)GO TO 10
50500		JRST	H10	; FOR GENL HOMING; WORDS;  BEAMS;  STEMS;
50600	
50700	;  ALF+=14= IS = WIDTH OF NOTE -- NEEDED BECAUSE OF DIFF. STEM DIRECTIONS.
50800	;  NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
50900	H197:	SETOM POSI+=8		;197	JJ2=-1
51000		MOVE	R,.COMM.		;R3=R2
51100		MOVEM	R,DPYNEW
51200		FIXX(R)
51300		MOVE STF+3(R)	;RSTJ2
51400		MOVEM STF+10
51500		MOVEM R,.COMM.+3	;J2=STF#
51600		MOVE IZ,[6.0]
51700		SETZ	K,		;DO 191 K=1,ITEM
51800	H191:	MOVEM	K,LOOP		;SAVE K       	L=PWDS(K)
51900		MOVE	L,PTR(K)	; L IS PWDS(K+1)
52000			;IF(RN(L+1).NE.6)GO TO 191   -- NO ADJUSTMENT IF P10.NE.0
52100		MOVEI	R,XRN(L)
52200		CAME IZ,(R)
52300		JRST	HX191
52400		MOVE	JK,DPYNEW		;IF(RN(L+2).EQ.R3)GO TO 77
52500		CAMN	JK,1(R)
52600		JRST	H77
52700		CAMGE	JK,[=5.0]	;IF(R3.LT.5.)GO TO 191
52800		JRST 	HX191		; TYPE AD 99 FOR ALL STAVES  (=19 99)
52900	H77:	MOVE	JK,-1(R)		;77
53000		CAMN	JK,[=8.0]	;IF(RN(L).EQ.8)GO TO 191
53100		JRST	HX191
53200		MOVE	JK,6(R)		;IF(RN(L+7).LT.10.)GO TO 191
53300		CAMGE	JK,[=10.0]	;C  FINDS BEAMS.
53400		JRST	HX191
53500		FDVR	JK,[=10.0]	;X=RG/10.
53600		FIXX(JK)			;C  STEM DIRECT.
53700		MOVEM	JK,XNOTE		;X SAVED IN XNOTE
53800		MOVE	JK,1(R)		;R2=RN(L+2)
53900		MOVEM	JK,.COMM.	; USED IN 'FINDIT'
54000		MOVE	A,2(R)		;A=RN(L+3)-.01
54100		FSBR	A,[=0.01]
54200		MOVEM	A,NEWR		;SAVE A IN NEWR
54300		MOVM RC,3(R)	;RC=ABS(RN(L+4))   RC USED AFTER H192
54400		FSBR RC,[90.0]	;NEG=MAXI SIZE,  POS=MINI SIZE BEAMS.
54500		MOVE	JK,5(R)		;B=RN(L+6)+.01
54600		FADR	JK,[=0.01]	;C  POS 1 AND 2
54700		MOVEM	JK,BAUTO		;B SAVED IN BAUTO
54800		FSBR	JK,A		;DISX=B-A
54900		MOVEM	JK,UPDATE	;DISX SAVED IN UPDATE
55000	;  DISTANCE IN REAL STEPS
55100		MOVEM	R,NALF		;SAVE LOC OF RN(L+1)
55200		MOVE	0,3(R)
55300		MOVEM	0,JUGGLE
55400		JSA	16,AMOD		;RF=AMOD(RN(L+4),100.0)
55500		JUMP	JUGGLE 
55600		JUMP	[=100.0]
55700		MOVEM	0,JUGGLE; THIS IS RF!!!!
55800	;  NOTE 2
55900		MOVE	JK,NALF 
56000		MOVE	JK,4(JK)
56100		MOVEM	JK,MSSLUP
56200		JSA	16,AMOD		;RB=AMOD(RN(L+5),100.0)
56300		JUMP	MSSLUP 
56400		JUMP	[=100.0]	;0 WILL HAVE RB!!!
56500		FSBR	0,JUGGLE 
56600		MOVEM	0,SORT2 		;RD SAVED IN ALF+=9  --  RD=RB-RF
56700		MOVEI NX,1
56800	H192:	JSA	16,FINDIT	;IF(FINDIT(N))GO TO 192
56900		JUMP	NX
57000		JUMPL	0,HX192
57100		MOVEI	R,XRN		;IF(RN(L).EQ.8)GO TO 192
57200		ADD	R,PTR+=251	;LOC OF RN(L+1)
57300		MOVE	JK,-1(R)
57400		CAMN	JK,[=8.0]
57500		JRST	HX192
57600		JUMPGE RC,.+4	;JUMP IF MINI-BEAMS. THEY WILL LOOK FOR MININOTES
57700		MOVE	JK,7(R)		;IF(RN(L+8).GE.1000.)GO TO 192
57800		CAML	JK,[=1000.0]
57900		JRST	HX192	; SKIPS SLASHED GRACE NOTES (P8=1000 OR P10=1)
58000	;  FINDIT IS NEG. IF(RN(L+1).NE.1.OR.RN(L+3))
58100		MOVE	A,2(R)		;RC=RN(L+3)
58200		SETZM STFLG#		;FOR NOTES ON DIF. STF. (+1000↓,2000↑)
58300		MOVM MM,3(R)		; GET RN(L+4)
58400		CAMGE MM,[1000.0]	; .GE.1000 ?
58500		JRST HX4		; NO
58600		MOVE IEND,STF+10	; GET RSTJ2
58700		SKIPL RC		; IS IT A MINI?
58800		FMPR IEND,[0.6]		; YES, *.6
58900		MOVE IS,[2.44]	; 2.44 IS NOTE WIDTH
59000		FMPR IS,IEND	; *RMINI
59100		CAML  MM,[2000.0]	; IS IT ON STAFF BELOW (1000)
59200		MOVNS IS		; NEG. NOTE WIDTH
59300		MOVE IZ,NALF		; GET LOC OF RN(L+1) P1 OF THE BEAM
59400		MOVM IZ,6(IZ)		; IZ=P7, NUMB OF BEAMS
59500		JSA 16,AMOD		; GO FIND SECOND DIGIT.
59600		JUMP IZ
59700		JUMP [10.0]
59800		MOVE IZ,		; GET THE RESULT INTO RIGHT AC
59900		FSBR IZ,[1.0]		; LESS 1
60000		FMPR IZ,[1.571429]	; *SPACE BETWEEN BEAMS
60100	;;;	FMPR IZ,IEND		; *RMINI
60200		MOVEM MM,STFLG		; FLG HAS 1000+ OR 2000+
60300		FADR A,IS		; ADD OR SUB. NOTE WIDTH TO POS.
60400	;;	MOVE 5(R);;	;;	;GET P6
60500	;;	CAMGE [10.0];;	;;	;IF(P6.LT.10)GO TO HX4
60600	;;	JRST HX4
60700	;;	MOVE JK,[2.44];;	;;	; THE SIZE OF A NOTE
60800	;;	MOVE L,1(R);;	;;	; GET STAFF #
60900	;;	FIXX(L)
61000	;;	FMPR JK,STF+3(L);;	;*RSTFAC(L)
61100	;;	CAML [20.0];;	;;	;IF(P6.GE.20) SZ=-SZ
61200	;;	MOVNS JK
61300	;;	FADR A,JK;;	;;	;PUT SHIFTED POS. INTO A
61400	HX4:	CAML	A,NEWR		;IF(RC.LT.A)GO TO 192
61500		CAMLE	A,BAUTO		;IF(RC.GT.B)GO TO 192
61600		JRST	HX192	;  WHAT'S LEFT IS IN BEAM AREA IF STEM DIR. IS OK.
61700		MOVE	JK,4(R)		;IF(X.NE.IFIX(RN(L+5)/10.))GO TO 192
61800		FIXX(JK)
61900		IDIVI JK,=10
62000	;;;	SKIPE STFLG	; SKIP IF NOTE IS ON DIFF. STAFF
62100	;;;	JRST .+3  
62200		CAME	JK,XNOTE	;JK IS STEM DIR. OF NOTE; XNOTE, FOR BEAM
62300		JRST	HX192
62400		FSBR	A,NEWR		;RC=RC-A
62500		MOVEM	A,MVBEAM;SAVES RC
62600		MOVEM	R,MVBX 		;SAVE LOC OF RN(L+1)
62700		MOVE 	0,3(R)
62800		MOVEM	0,MSSLUP
62900		JSA	16,AMOD		;193	RE=AMOD(RN(L+4),100.0)
63000		JUMP	MSSLUP
63100		JUMP	[=100.0]
63200		MOVEM	0,ALF+3		;RE SAVE HERE
63300		SKIPN STFLG	; IF(STFLG.EQ.0)GO TO H577
63400		JRST H577
63500		MOVEI IS,1	; IS=1
63600		CAIE JK,1	; IF(JK.NE.1)IS=-1 -- STEM ↑ =1
63700		SETO IS,
63800		MOVE R,.COMM.+3		;NN=(STFF(R+IS)-STFF(R))/7.
63900		MOVN NN,POSI+3(R)
64000		ADD R,IS
64100		FADR NN,POSI+3(R)
64200		MOVE [7.0]
64300		FMPR IEND		; 7*RMINI
64400		FDVR NN,
64500		MOVMS NN		; ABS VALUE
64600		FSBR NN,[13.714]	; -2:STEM LENGTH
64700	;;	FDVR NN,IEND		;  /RMINI
64800	;;	CAIN JK,1		; IF(JK.EQ.1)NN=-NN
64900	;;	MOVNS NN
65000	H577:	MOVE	JK,SORT2 		;RC=RD*RC/DISX+RF
65100		FMPR	JK,MVBEAM	;*RC
65200		FDVR	JK,UPDATE 	;/DISX
65300		FADR	JK,JUGGLE 	;+RF
65400		MOVEM	JK,MVBEAM	;RC=
65500		MOVE	JK,MVBX
65600		MOVE	JK,6(JK)		;RG=RN(L+7)
65700		MOVEM	JK,ALF+4		;SAVE RG
65800		JSA	16,AMOD		;RN(L+7)=RG-AMOD(RG,10.0)+AMOD(RG,1.0)
65900		JUMP	ALF+4
66000		JUMP	[=10.0]
66100		MOVEM	0,LUP2
66200		JSA	16,AMOD
66300		JUMP	ALF+4
66400		JUMP	[=1.0]
66500		FSBR	0,LUP2
66600		FADR	0,ALF+4
66700		MOVE	L,MVBX
66800		MOVEM	0,6(L) ;DELETES TAILS WITHOUT REMOVING DOTS OR SPACING OF DOTS.
66900	;  FRACTIONAL NOTE #
67000		MOVE	R,MVBEAM	;195	RA=RC-RE
67100		FSBR	R,ALF+3
67200		MOVE	JK,XNOTE		;IF(X.EQ.2)RA=-RA
67300		CAIN	JK,2
67400		MOVNS	R
67500	;;	SKIPN	R		;IF(RA.EQ.0)RA=999.
67600	;;	MOVE	R,[=999.0]
67700		MOVE 0,7(L)	;IF(RN(L+8).GT.999)RA=RA+1000.  FOR MINI-NOTES
67800		CAMLE 0,[999.0]
67900		FADR R,[1000.0]
68000		SKIPN STFLG		; IF(STFLG.NE.0)R=R+NN
68100		JRST .+4		; NEXT FOR NOTES ON DIFF. STF.
68200		FSBR R,NN
68300		MOVNS R
68400		FADR R,IZ			; ADD FOR MULTIPLE BEAMS
68500		MOVEM	R,7(L)		;196	RN(L+8)=RA
68600	;  FRACTIONAL NOTE # - FIRST NOTE OF GROUP + THIS NOTE # ALL *7.
68700		SKIPGE	POSI+=8
68800		MOVEM	NX,POSI+=8	;  SAVES # OF LOWEST ITEM FOUND
68900	HX192:	CAMGE	NX,PTR+=250	;192	CONTINUE   
69000		AOJA	NX,H192
69100	HX191:	MOVE	K,LOOP		;191	CONTINUE
69200		CAMGE K,PTR+=250
69300		AOJA K,H191
69400		JRA	16,(16)		;RETURN
69500	H9:	SKIPGE	.COMM.+=32	;9	IF(J11.LT.0)RETURN
69600		JRA	16,(16)		;   IF P11=-1 NO HOMING
69700		MOVM	R,.COMM.+=28	;	X=IABS(J7)/10  CC  X=R7/10.
69800		IDIVI	R,=10		;;;FDVR	R,[=10.0]
69900	;;;	FIXX(R)
70000	;;;	SKIPGE	R		;IF(X)X=-X
70100	;;;	MOVNS	R
70200		MOVEM	R,XNOTE		;X SAVED IN XNOTE
70300	;  X IS STEM DIRECTION
70400	;;;	MOVE	L,.COMM.+=10	;RA=R9
70500	;  R9= POS3
70600		MOVNI	RC,1	;RC=-1 
70700		SKIPE	.COMM.+=10	;IF(R9.NE.0)RC=-2
70800		MOVNI	RC,2
70900		MOVE	JK,.COMM.+=31	;IF(J10/10.EQ.3)RC=-3
71000		IDIVI	JK,=10		;JT HAS REMAINDER (AC4)
71100		CAIN	JK,3
71200		MOVNI	RC,3		;  RC=0 ESCAPES FRCOM LOOP.
71300	;;;	JRST	HZ10
71400	;;;H10:	SETZ	RC,		;FOR P13=1
71500	;   HOMING RANGE FOR BEAMS
71600	;;;HZ10:	MOVE	IS,.COMM.+=12	;10	IF(R11.EQ.0)R11=2.9
71700	H10:	MOVE	IS,.COMM.+=12	;10	IF(R11.EQ.0)R11=2.9
71800		JUMPN	IS,HX10
71900		MOVE	IS,[=2.9]
72000		MOVEM	IS,.COMM.+=12	;   IF P11.NE.0 RANGE IS CHANGED FROM 2
72100	HX10:	MOVE	IZ,.COMM.+1	;	IF(JA.EQ.5)RC=-1
72200		CAIN	IZ,5
72300		MOVNI	RC,1
72400		MOVEI	K,1
72500		MOVE L,.COMM.+1		; JA IS NOW IN L
72600	H361:	JSA	16,FINDIT		;DO 361 K=1,ITEM
72700		JUMP	K
72800		JUMPL	0,HX361		;IF(FINDIT(K))GO TO 361
72900	;  SKIPS NOTES ON WRONG LINE 
73000		MOVEI	R,XRN		;RD=RN(L+3)
73100		ADD	R,PTR+=251	;LOC OF RN(L+1)
73200		MOVE	A,2(R)		;RD IN A
73300		MOVEM	A,RMOD+=9	;1	IF(JA.NE.6)GO TO 177
73400		MOVE	JK,4(R)		;IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
73500		CAIE	L,6
73600		JRST	H177
73700		FIXX(JK)
73800		IDIVI JK,=10
73805		MOVM 3(R)	;IF(RN(L+4).LT.1000)GO TO H177
73810		CAMGE [1000.0]
73815		JRST H377
73816		MOVE 1,[2.44]
73817		FMPR 1,STF+=8	;*RSTJ2
73818		MOVM NN,.COMM.+=25	;IF(ABS(J4.GE.100)  *.6   (MINI)
73819		CAIL NN,=90   
73820		FMPR 1,[0.6]
73826		CAML [2000.0]	;IF(    .GE.2000)GO TO H377
73845		MOVNS 1
73850		FADR A,1	; ADD OR SUB. NOTE WIDTH FROM NOTE POS.
73900	H377:	CAME	JK,XNOTE
74000		JRST	HX361
74100	H177:	JSA	16,PLACE	;177	IF(PLACE(R3))GO TO 461
74200		JUMP	.COMM.+4
74300		JUMPL	H461
74400		SETOM IZ
74500	HX2:	MOVE 5(R)	;GET PARAM 6
74600		CAMGE [10.0]	; MUST BE .GE.10 
74700		JRST HX1
74800		MOVE IS,[2.44]	; SIZE OF A NOTE
74900		CAML [20.0]	; 10 = RIGHT SHIFT, 20 = LEFT SHIFT
75000		MOVNS IS
75100		MOVM 3(R)		; GET P4
75200		CAML [100.0]		; IS IT A MINI?
75300		CAML [200.0]
75400		SKIPA
75500		FMPR IS,[0.6]		;*RMINI
75600		MOVE 1,.COMM.+3		;STAFF #
75700		FMPR IS,STF+3(1)	;*RSTFAC(J2)
75800		FADR A,IS
75900	HX1:	JUMPG IZ,HX8	; JUMP TO CHANGE P6, 8 OR 9
76000	HX3:	MOVEM	A,.COMM.+4	;R3=RD
76100	;  LOOKS FOR NOTE, STAFF #, STEM DIR.
76200		MOVN .COMM.+=14		;P13=-1 HOME TO NOTE SIDE, =-2 TO STEM.
76300		SKIPG			;IS IT NEG.
76400		JRST H11		; NO, GO TO NEXT SECTION.
76500		MOVE IS,3(R)	; VERTICAL POS OF NOTE (P4)
76600		CAME [1.0]	;IS P13 -1 OR -2?
76700		JRST H12	;IT'S -2
76800		MOVE [2.0]
76900		CAMGE JK,[20.0]		;WHICH WAY IS STEM?
77000		MOVNS
77100		FADR IS		;ADD NOTE LEVEL
77200		MOVEM .COMM.+5		;P4=NOTE LEVEL + OR - 2.
77300		JRST H11
77400	H12:	MOVE IZ,7(R)	; STEM LENGTH
77500		CAMN IZ,[999.0]   ; WHAT ABOUT 16TH AND 32ND NOTES??
77600		SETZ IZ,
77700		FADR IZ,[8.0]
77800		JSA 16,AMOD
77900		JUMP 6(R)
78000		JUMP [10.0]	;AC0=AMOD(R7,10.0)
78100		SKIPN
78200		JRST H13
78300		FSBR [1.0]	;IGNORE 1ST TAIL
78400		FMPR [1.8]	; *SPACE FOR EACH TAIL
78500		FADR IZ,	; ADD TO STEM LENGTH
78600	H13:	CAML JK,[20.0]
78700		MOVNS IZ	;PUT IT UPSIDE DOWN.
78800		FADR IS,IZ	;ADD NOTE LEVEL
78900		MOVEM IS,.COMM.+5	;PUT IT BEYOND STEM
79000	H11:	CAIN	L,6		;IF(JA.EQ.6)GO TO 861
79100		JRST	 H861
79200		CAIN	L,5		;IF(JA.EQ.5)GO TO 261
79300		JRST	H261
79400		JRA	16,(16)		;RETURN
79500	H461:	CAIN	L,6		;461	IF(JA.EQ.6)GO TO 277
79600		JRST	H277
79700		CAIE	L,5		;IF(JA.NE.5)GO TO 361
79800		JRST	HX361
79900	H277:	JSA	16,PLACE	;277	IF(PLACE(R6))GO TO 561
80000		JUMP	.COMM.+7
80100		JUMPL	H561
80200		MOVEI IZ,7		;R6=RD
80300		JRST HX2
80400	H861:	MOVE	0,.COMM.+=28	;861	IF(J7.GE.0)GO TO 261
80500		JUMPGE	0,H261
80600	H561:	JSA	16,PLACE	;561	IF(PLACE(R9))GO TO 661
80700		JUMP	.COMM.+=10	;R9
80800		JUMPL	H661
80900		MOVE	0,.COMM.+=28	;IF(J7)GO TO 761
81000		JUMPL	H761	;  J7=NEG MEANS TREMOLO
81100		MOVE	0,.COMM.+=9	;	IF(R8.NE.0)GO TO 761
81200		JUMPN	H761
81300		MOVE	0,.COMM.+=11	;	IF(R10.EQ.0)GO TO 361
81400		JUMPE	HX361
81500	H761:	MOVEI IZ,=10		;761	R9=RD
81600		JRST HX2
81700	;  R8=0, R10=0 MEANS R9 IS NUMBER OUTSIDE OF BEAM.    ; GO TO 261
81800	H661:	CAIN	L,5		;661	IF(JA.EQ.5)GO TO 361
81900		JRST	HX361
82000		MOVE	0,.COMM.+=31	;IF(J10.LT.30)GO TO 361
82100		CAIGE	0,=30
82200		JRST	HX361
82300		JSA	16,PLACE	;IF(PLACE(R8))GO TO 361
82400		JUMP	.COMM.+=9
82500		JUMPL	HX361	; HOMES INNER PARTIAL BEAMS
82600		MOVEI IZ,=9		;R8=RD
82700		JRST HX2
82800	HX8:	MOVEM	A,.COMM.(IZ)	;PUT A INTO RIGHT PARAM.
82900	H261:	SKIPN	RC       	;261	IF(RC.EQ.0)RETURN
83000		JRA	16,(16)    
83100		AOJ	RC		;RC=RC+1
83200	HX361:	CAMGE	K,PTR+=250	;361 	CONTINUE
83300		AOJA	K,H361
83400		JRA	16,(16)		;	END
83500	
83600	;	CALL FSCAN
83700	;	GOTO RT
83800	;	GOTO LF
83900	;	GOTO UP
84000	;	GOTO DW
84100	;	GOTO 1/2
84200	;	GOTO *2
84300	;	GOTO X
84400	;	GOTO C
84500	;	ALL OTHERS(EXIT)
84600	
84700	FSCAN:	0
84800		INCHRW
84900		MOVE 2,[ASCII/     /]
85000		MOVEM 2,ALF
85100		MOVE 2,[XWD ALF,ALF+1]
85200		BLT 2,ALF+=71			; CLEANS OUT INP ARRAY
85300		CAIN ";"
85400		JRA 16,(16)
85500		CAIN ":"
85600		JRA 16,1(16)
85700		CAIN "("
85800		JRA 16,2(16)
85900		CAIN ")"
86000		JRA 16,3(16)
86100		CAIN "/"
86200		JRA 16,4(16)
86300		CAIN "*"
86400		JRA 16,5(16)
86500		CAIN "X"
86600		JRA 16,6(16)
86700		CAIN "C"
86800		JRA 16,7(16)
86900		JRA 16,8(16)
87000	
87100	
87200	NALF:	0
87300		MOVE 0,@(16)
87400		JUMPGE .+4		;IF(I.GE.0)GO TO 20
87500		MOVE 1,[405004020100]	;  J='A'=405004020100
87600		SETO 2,			; M=-1
87700		JRST .+3		;GO TO 10
87800		MOVE 1,[201004020100]	;20  J=' '=201004020100
87900		MOVEI 2,=16		; M=16
88000		SUB 0,1			;10 NALF=(I-J)/536870912-M
88100		IDIV 0,[3777777777]	
88200		SUB 0,2
88300		JRA 16,1(16)
88400	
88500	BOX:	0    	;CALL BOX(I,R)   SEE PLTSRT.F4 FOR FORTR. VERSION
88600		MOVE 14,@(16)	; I IS IN 14
88700		JUMPL 14,BX4
88800		MOVE 13,@1(16)	; GET R
88900		FIXX(13)	; K=R
89000		JSA 16,AMOD
89100		JUMP XRN+3(14)	; GET REAL P4
89200		[100.0]
89300		FMPR [7.0]
89400		FMPR STF+3(13)	;*STAFF FACTOR
89500		FADR POSI+3(13)	; + STAFF VERT. POS.
89600		FSBR [40.0]	;  SHIFT CURSOR DOWN A BIT.
89700		FMPR SIZ
89800		MOVE 13,
89900		FIXX(13)
90000		SUB 13,SIZ+2	;13=K
90100		JSA 16,RHORZ	; GET HORIZ. POS.
90200		JUMP XRN+2(14)
90300		FMPR SIZ	;SIZ IS FOR ZOOMED IMAGES
90400		MOVE 12,	;  12=L
90500		FIXX(12)
90600		SUB 12,SIZ+1
90700		CAIL 12,=550	; CHECK IF OUT OF BOUNDS OF CRT
90800		MOVEI 12,=511
90900		CAMG 12,[-=550]
91000		MOVE 12,[-=511]
91100		JSA 16,SETCUR
91200		12
91300		13
91400		[0]
91500		JRA 16,2(16)	; THE CURSOR IS IN POSITION
91600	BX4:	CAME 14,[-1]
91700		JRST BX5
91800		JSA 16,DPYSET
91900		[3]
92000		RINP
92100		[=100]
92200		JSA 16,DPYBRT
92300		[3]
92400	BX5:	MOVE 2,@1(16)	; GET R
92500		JSA 16,RHORZ
92600		2
92700		FMPR SIZ
92800		FIXX(0)
92900		SUB SIZ+1
93000		MOVM 2,
93100		CAILE 2,=550
93200		JRST BX6
93300		MOVEM 0,LOOP
93400		JSA 16,SETPOG
93500		[3]
93600		JSA 16,ALINE
93700		LOOP
93800		[-=511]
93900		LOOP
94000		[=511]
94100		JSA 16,DPYOUT
94200		[3]
94300	BX6:	JSA 16,SETPOG
94400		[1]
94500		JRA 16,2(16)
94600	
94700		END